	PROGRAM LASERS
C *** LAST REVISED ON 20-AUG-1987 07:16:38.04
C *** SOURCE FILE: [DL.GRAPHICS.LONGLIB]LASERS.FOR
C
C	CREATED:  DGL JULY 1987
C
C	THIS PROGRAM CONVERTS THE LONGLIB META FILE
C	INTO QUIC TEXT FILE FOR A QMS LASER PRINTER.
C	INCLUDES STRIPPING OF THE PLOT INTO PAGE SIZE SECTIONS.
C
C	THIS PROGRAM IS FORTRAN 77 COMPATIBLE WITH THE EXCEPTIONS:
C		1. TABS (^I) ARE USED TO INDENT LINES.
C		2. A VAX DEPENDENT ROUTINE IS USED TO GET COMMAND LINE.
C		3. INTEGER*2 USED IN REGET ROUTINE.  THIS CAN BE CHANGED
C		   TO INTEGER IF THIS IS ALSO DONE IN LONGLIB PRINTER
C		   HISTORY ROUTINES LIBRARY.
C
	CHARACTER*80 NAME
C
C	MACHINE DEPENDENT METHOD OF GETING THE FILE NAME FROM THE
C	RUN COMMAND LINE
C
	IERR=LIB$GET_FOREIGN(NAME,,IFLAG)
C
C	IF FILE NAME WAS NOT PRESENT ON ARGUMENT LINE THEN USE DEFAULT FILE NAME
C
	IF (NAME.EQ.' ') NAME='FOR003.DAT'
C
C	OPTION FLAGS
C	 ISTRIP = 1	ENABLES STRIPPING
C	 ISTRIP = 0	DISABLES STRIPPING
C	 IPRINT = 0	PROGRAM RUNS QUIETLY
C	 IPRINT = 1	PROGRAM PRINTS STATUS LINES
C
	ISTRIP=1
	IPRINT=1
C
C	OPEN PRINTER HISTORY FILE
C
	OPEN(UNIT=2,FILE=NAME,FORM='UNFORMATTED',STATUS='OLD',
     $		READONLY,ERR=299)
C
C	OPEN OUTPUT FILE
C
	OPEN(UNIT=3,FILE='OUT.LIS',FORM='FORMATTED',RECL=230,
     $		STATUS='NEW',ERR=399)
C
C	SEND INITIALIZATION CODES TO PRINTER
C
	CALL PRINIT(3)
C
C	CONVERT LONGLIB META FILE INTO PRINTABLE FILE
C
	CALL LASIT(2,3,ISTRIP,IPRINT)
C
C	SEND CLOSING CODES TO PRINTER
C
	CALL PRCLOS(3)
C
C	CLOSE FILE AND TERMINATE PROGRAM
C
	CLOSE(2)
	CLOSE(3)
	GOTO 999
C
C	FILE OPEN ERRORS
C
299	WRITE(*,298)
298	FORMAT(' *** COULD NOT OPEN INPUT FILE ***')
	GOTO 999
399	WRITE(*,398)
398	FORMAT(' *** COULD NOT OPEN OUTPUT FILE ***')
	GOTO 999
C
999	STOP
	END
C
	SUBROUTINE PRINIT(LU)
C
C	SEND PRINTER INITIALIZATION CODES INTO OUTPUT FILE
C
	WRITE (LU,300)
300	FORMAT(X,'^PY^-'/' ^IGV')
	RETURN
	END
C
	SUBROUTINE PRCLOS(LU)
C
C	RESET PRINTER 
C
	WRITE (LU,410)
410	FORMAT(X,'^IGE^O^-^PN^-')
	RETURN
	END
C
	SUBROUTINE NEWFORM(LU)
C
C	SET NEW PAGE TO PLOT ON
C
	WRITE (LU,402)
402	FORMAT(X,'^,')
	RETURN
	END
C
C
	SUBROUTINE LASIT(LUI,LUO,ISTRIP,IPRINT)
C
C	INPUT:
C
C	LUI	(I)	INPUT FILE LOGICAL UNIT NUMBER
C	LUO	(I)	OUTPUT FILE LOGICAL UNIT NUMBER
C	ISTRIP	(I)	STRIPPING CONTROL FLAG (AUTO STRIPPING=1)
C	IPRINT	(I)	PRINT CONTROL FLAG (NO PRINT=0)
C
C	READ INPUT FILE, DECODE COMMANDS, REMOVE REDUNDANT COMMANDS,
C	ELIMINATE ORIGIN CHANGE COMMANDS, AND SEND TO LASER PRINTER OUTPUT
C	FILE.
C
C	LONGLIB META FILE COMMANDS
C
C	IC	COMMAND
C
C	2	PEN DOWN MOVE
C	3	PEN UP MOVE
C	-2	PEN DOWN MOVE WITH NEW ORIGIN
C	-3	PEN UP MOVE WITH NEW ORIGIN
C	9	PEN ERASE MOVE
C	-9	PEN ERASE WITH NEW ORIGIN
C	10	NEW PAGE
C	11	END OF FILE
C	999	END OF FILE
C	1000	SET RESOLUTION
C	1001	SET LINE TYPE
C	1002	SET PEN COLOR
C	1003	SET LINE WIDTH
C	(ELSE)	INVALID
C
C	FIRST COMMAND IN FILE SHOULD SET RESOLUTION
C
	INTEGER ICOM(13)
	DATA ICOM/2,3,-3,1001,1002,1003,10,-2,9,-9,11,999,1000/
	INTEGER ITRN(14)
	DATA ITRN/2,3, 3,   6,   5,  10, 8, 2,4, 4, 9,  9,   7,1/
C
C	READ BUFFER
C
	INTEGER M(128)
C
C	OUTPUT FLAGS
C
	LOGICAL BLANK,PENUP,LAST,PENWID,PENTYP
C
	COMMON /RAST/XSWIDE,YSWIDE,XRES,YRES,XLIM,YLIM,IXOFF,IYOFF,MAXSTR
C
C	SET PRINTER DEPENDENT PARAMETERS
C
	CALL SETPAR
C
C	SET MISC PARAMETERS
C
C	SX	DEFAULT X RESOLUTION OF HISTORY FILE (INCH/DOT)
C	SY	DEFAULT Y RESOLUTION OF HISTORY FILE (INCH/DOT)
C
	SX=300.
	SY=400.
C
C	INITIALIZE LAST LINE/COLOR
C
	LSC=1
	LWIDE=1
	LLINE=1
	LCOL=1
C
C	INITIALIZE PAGE COUNTER
C
	NPAGE=1
	BLANK=.TRUE.
	ICC=0
C
	IF (IPRINT.NE.0) WRITE(*,3000)
3000	FORMAT(' BEGIN QMS LASER METAFILE CONVERSION')
C
C	INITIALIZE FILE BUFFERS
C
	MP=999
C
C	TOP OF INTERIOR LOOP
C
12	CONTINUE
C
	IF (IPRINT.NE.0) WRITE(*,3010) NPAGE
3010	FORMAT(' BEGIN FIRST STRIP OF INPUT PAGE',I6)
	NXSTRIP=1
	NYSTRIP=1
	XMAX=0.
	YMAX=0.
C
C	NOTE THAT ORIGIN IS NOT PRESERVED OVER PAGE CHANGE
C
	XORG=0.
	YORG=0.
C
C	CHECK FOR COMPLETION OF TASK
C
	IF (ICC.EQ.11.OR.ICC.EQ.999) GOTO 110
C
C	START NEW STRIP
C
112	CONTINUE
C
C	INITIALIZE BLANK PAGE DETECT FLAG
C
	BLANK=.TRUE.
C
C	INITIALIZE LAST X,Y COMMANDS (LX,LY) ARE QUANTIZED VERSIONS
C
	PX=0.
	PY=0.
	LX=0
	LY=0
C
C	PENUP FLAG INDICATES POSITION OF PEN WHILE LAST FLAG INDICATES
C	WHETHER WE HAVE OUTPUT LAST COORDINATE
C
	PENUP=.TRUE.
	LAST=.FALSE.
	PENWID=.TRUE.
	PENTYP=.TRUE.
C
C	READ EACH COMMAND IN HISTORY FILE
C
13	CALL REGET(M1,M2,ICC,MP,LUI,M)
C
C	CHECK FOR END OF FILE
C
	IF (ICC.EQ.11.OR.ICC.EQ.999) GOTO 10
C
C	DETERMINE COMMAND CODE
C
	DO 210 IC=1,13
		IF (ICOM(IC).EQ.ICC) GOTO 215
210	CONTINUE
	IC=13
215	CONTINUE
C
C	DECODE COMMAND AND EXECUTE
C
	GOTO (23,23,23,1001,1002,1003,10,23,23,23,10,10,1000,13) IC	
	GOTO 13
C
C	HANDLE A PEN MOTION COMMAND
C
23	CONTINUE
C
C	CONVERT INPUT INTEGERS INTO REAL LOCATION VALUES
C
	Y1=M1*SY+YORG
	X1=M2*SX+XORG
C
C	DETERMINE MAXIMUM AND MINIMUM VALUES USED FOR X AND Y TO DETERMINE
C	HOW MUCH STRIPING IS NEEDED
C
	XMAX=AMAX1(XMAX,X1)
	YMAX=AMAX1(YMAX,Y1)
C
C	RESET ORIGIN
C
	IF (ICC.LT.0) THEN
		XORG=X1
		YORG=Y1
	ENDIF
C
C	CLIP LINE TO CURRENTLY VISIBLE STRIP
C
	X2=X1-(NXSTRIP-1)*XSWIDE
	Y2=Y1-(NYSTRIP-1)*YSWIDE
C
C	FOR PEN UP MOVES WE NEED ONLY STORE THE POINT
C
	IF (ITRN(IC).EQ.3) THEN
		PX=X2
		PY=Y2
		LX=-99
		LY=-99
		PENUP=.TRUE.
		LAST=.FALSE.
		GOTO 13
	ENDIF
C
C	GET CLIP FLAGS
C
	CALL CLIPS(IVT,XV1,YV1,XV2,YV2,X2,Y2,PX,PY,0.,0.,XLIM,YLIM)
C
C	CHECK FOR CLIPPING ROUTINE ERROR
C
	IF (IVTB.LT.0) THEN
		WRITE(*,33) 
33		FORMAT(' *** CLIPPING ROUTINE ERROR ***')
		PX=X2
		PY=Y2
		LX=-99
		LY=-99
		PENUP=.TRUE.
		LAST=.FALSE.
		GOTO 13
	ENDIF
C
C	CHECK FOR ENTIRELY INVISIBLE LINE
C
	IF (IVT.NE.0) THEN
		PX=X2
		PY=Y2
		LX=-99
		LY=-99
		PENUP=.TRUE.
		LAST=.FALSE.
		GOTO 13
	ENDIF
C
C	LINE IS AT LEAST PARTLY VISIBLE, SEND TO INTERMEDIATE PEN MOTION FILE
C
C	FIRST SEND PEN WIDTH AND TYPE IF NOT PREVIOUSLY SEND
C
	IF (PENTYP) THEN
		CALL LASOUT(LLINE,LSC,6,LUO)
		PENTYP=.FALSE.
	ENDIF
	IF (PENWID) THEN
		CALL LASOUT(LWIDE,0,10,LUO)
		PENWID=.FALSE.
	ENDIF
C
C	NOW SEND START POINT OF LINE IF NOT PREVIOUSLY SENT
C
	IX=IFIX(XV2*XRES+0.4999)+IXOFF
	IY=IFIX(YV2*YRES+0.4999)+IYOFF
	IF (.NOT.LAST.OR.IX.NE.LX.OR.IY.NE.LY) THEN
		CALL LASOUT(IX,IY,3,LUO)
		LAST=.TRUE.
		PENUP=.TRUE.
	ENDIF
	LX=IX
	LY=IY
	IX=IFIX(XV1*XRES+0.4999)+IXOFF
	IY=IFIX(YV1*YRES+0.4999)+IYOFF
	PX=X2
	PY=Y2
C
C	SEND END POINT OF LINE
C
	IF (PENUP.OR.IX.NE.LX.OR.IY.NE.LY) THEN
		CALL LASOUT(IX,IY,ITRN(IC),LUO)
	ENDIF
	PENUP=.FALSE.
	LX=IX
	LY=IY
C
C	IF VISIBLE PEN DOWN MOTION OCCURS THEN FLAG PAGE AS NOT BLANK
C
	IF (ITRN(IC).EQ.2) BLANK=.FALSE.
	GOTO 13
C
C	HANDLE NEW PAGE COMMANDS
C
10	CONTINUE
C
C	WRITE LAST RECORD TO OUTPUT FILE
C
	CALL LASOUT(NXSTRIP,NYSTRIP,8,LUO)
C
C	FINISH UP CURRENT STRIP
C
	IF (BLANK) THEN
		IF (IPRINT.NE.0) WRITE(*,3030) NXSTRIP,NYSTRIP
3030		FORMAT(' BLANK STRIP ',I6,',',I6)
	ELSE
		CALL NEWFORM(LUO)
		IF (IPRINT.NE.0) WRITE(*,3020) NXSTRIP,NYSTRIP
3020		FORMAT(' OUTPUT STRIP ',I6,',',I6)
	ENDIF
C
C	COMPUTE NUMBER OF STRIPS IN EACH DIRECTION
C
	NXM=XMAX/XSWIDE+1
	NYM=YMAX/YSWIDE+1
C
C	IS STRIPPING ENABLED?  IF NOT INCREMENT PAGE AND CONTINUE
C
	IF (ISTRIP.NE.1) THEN
		IF (IPRINT.NE.0) WRITE(*,3045) NXSTRIP*NYSTRIP,NPAGE
3045		FORMAT(' STRIPPING DISABLED. ',I6,' STRIPS REQUIRED',
     $			' FOR INPUT PAGE',I6)
		NPAGE=NPAGE+1
		GOTO 12
	ENDIF
C
C	HAVE WE DONE ALL THE STRIPS THAT ARE REQUIRED?
C	IF NOT THEN REWIND INPUT FILE AND REPROCESS
C	OTHERWISE INCREMENT PAGE COUNTER AND PROCESS NEXT CASE
C
	IF (NXSTRIP.GE.NXM.AND.NYSTRIP.GE.NYM) THEN
		NPAGE=NPAGE+1
		GOTO 12
	ENDIF
C
C	NEW STRIP NUMBER
C
	IF (NXSTRIP.LT.NXM) THEN
		NXSTRIP=NXSTRIP+1
	ELSE
		NXSTRIP=1
		NYSTRIP=NYSTRIP+1
	ENDIF
C
C	WRITE WARNING IF NUMBER OF STRIPS EXCEEDS MAXIMUM
C
	IF (NXSTRIP*NYSTRIP.GT.MAXSTR.AND.NXSTRIP.EQ.1
     $		.AND.NYSTRIP.EQ.1) WRITE(*,3055) NXSTRIP*NYSTRIP,NPAGE
3055	FORMAT(' *** WARNING ',I6,' STRIPS REQUIRED FOR INPUT PAGE',I6)
C
	IF (IPRINT.NE.0) WRITE(*,3050) NXSTRIP,NYSTRIP,NXM,NYM
3050	FORMAT(' REREAD INPUT STRIP',I6,',',I6,'  OF ',I6,',',I6)
C
C REWIND INPUT FILE AND FIND CORRECT PAGE LOCATION
C
	REWIND(LUI)
	MP=999
C
C	FIND CORRECT LOCATION IN FILE
C
	IPGE=1
40	CONTINUE
C
C	IS THE CURRENT PAGE THE SAME AS THE PAGE POINTER IN THE FILE?
C	IF SO START NEW STRIP
C
	IF (IPGE.EQ.NPAGE) GOTO 112
45	CALL REGET(M1,M2,ICC,MP,LUI,M)
C
C	CHECK FOR END OF FILE -- IF WE HAVE REACHED IT WE ARE IN TROUBLE
C	SO EXIT WITH ERROR
C
	IF (ICC.EQ.11.OR.ICC.EQ.999) GOTO 199
C
C	COUNT UP NEW PAGE COMMANDS, SKIP THE REST
C
	IF (ICC.NE.10) GOTO 45
	IPGE=IPGE+1
	GOTO 40
C
C	SET RESOLUTION
C
1000	CONTINUE
C
C	CHECK FOR INPUT ERROR -- IF THERE IS, EXIT
C
	IF (M1.EQ.0.OR.M2.EQ.0) GOTO 110
	SX=1./FLOAT(M2)
	SY=1./FLOAT(M1)
	GOTO 13
C
C	CHANGE LINE TYPE COMMAND
C
1001	CONTINUE
C
C	M1 = LINE TYPE PATTERN MASK
C	M2 = LINE TYPE SCALE FACTOR
C
C	LASER PRINTER DOES NOT DO SCALE FACTOR SO WE WILL USE LINE TYPE
C	NUMBER FOR CONVENIENCE
C
	IF (M1.NE.LLINE.OR.LSC.NE.M2) PENTYP=.TRUE.
	LLINE=M1
	LSC=M2
	GOTO 13
C
C	CHANGE LINE COLOR COMMAND
C
1002	CONTINUE
C
C	M2 IS THE COLOR INDEX
C
	LCOL=M2
	GOTO 13
C
C	CHANGE LINE WIDTH COMMAND
C
1003	CONTINUE
C
C	M1 IS THE PEN WIDTH (0 EQUIV TO 1)
C
	IF (M1.LT.0) M1=1
	IF (M1.NE.LWIDE.AND.M1.NE.0) PENWID=.TRUE.
	LWIDE=M1
	GOTO 13
C
C	ALL FINISHED WITH EVERYTHING
C
110	CONTINUE
	RETURN
C
199	CONTINUE
	WRITE(*,198)
198	FORMAT(' *** ERROR IN INPUT FILE REACHED END OF FILE EARLY ***')
	RETURN
	END
C
	SUBROUTINE CLIPS(IFLAG,XV1,YV1,XV2,YV2,X1,Y1,X2,Y2,XM,YM,XX,YX)
C
C	CLIPS THE LINE FROM X1,Y1 TO X2,Y2 TO THE RECTANCLE XM,YM XX,YX
C	CLIPPED LINE IS XV1,YV1 (CLIPPED X1,Y1) AND  XV2,YV2 (CLIPPED X2,Y2)
C
C	RETURNS IFLAG=-1 FOR ERROR, IFLAG<>0 FOR NOT VISIBLE, AND IFLAG=0
C	FOR AT LEAST PARTLY VISIBLE LINE
C
	XV1=X1
	YV1=Y1
	IV1=IPCLIP(XV1,YV1,XM,YM,XX,YX)
	XV2=X2
	YV2=Y2
	IV2=IPCLIP(XV2,YV2,XM,YM,XX,YX)
C
C	RETURN IF COMPLETELY VISIBLE OR INVISIBLE
C
	IFLAG=IOR(IV1,IV2)
	IF  (IFLAG.EQ.0) RETURN
	IFLAG=IAND(IV1,IV2)
	IF (IFLAG.NE.0) RETURN
C
C	OTHERWISE CLIP PARTIALLY VISIBLE LINE
C
	IC1=ICLIPS(IV1,XV1,YV1,X2,Y2,XM,YM,XX,YX)
	IC2=ICLIPS(IV2,XV2,YV2,X1,Y1,XM,YM,XX,YX)
	RETURN
	END
C
	INTEGER FUNCTION ICLIPS(IV,XV,YV,X2,Y2,XM,YM,XX,YX)
C
C	CLIPS LEFT SIDE LINE FROM XV,YV TO X2,V2 IN BOX XM,YM,XX,YX
C
C	CLIP LEFT EDGE
C
	IF (IAND(IV,1).NE.0) THEN
		YV=YV+(Y2-YV)*(XM-XV)/(X2-XV)
		XV=XM
		IV=IPCLIP(XV,YV,XM,YM,XX,YX)
	ENDIF
C
C	CLIP RIGHT EDGE
C
	IF (IAND(IV,2).NE.0) THEN
		YV=YV+(Y2-YV)*(XX-XV)/(X2-XV)
		XV=XX
		IV=IPCLIP(XV,YV,XM,YM,XX,YX)
	ENDIF
C
C	CLIP BOTTOM EDGE
C
	IF (IAND(IV,4).NE.0) THEN
		XV=XV+(X2-XV)*(YM-YV)/(Y2-YV)
		YV=YM
		IV=IPCLIP(XV,YV,XM,YM,XX,YX)
	ENDIF
C
C	CLIP TOP EDGE
C
	IF (IAND(IV,8).NE.0) THEN
		XV=XV+(X2-XV)*(YX-YV)/(Y2-YV)
		YV=YX
		IV=IPCLIP(XV,YV,XM,YM,XX,YX)
	ENDIF
	ICLIPS=IV
	RETURN
	END
C
	SUBROUTINE REGET(M1,M2,M3,MP,ILU,M)
C
C	READ DATA FROM LONGLIB PRINTER HISTORY META FILE
C	
	INTEGER*2 M(128)
	MP=MP+3
	IF (MP.GT.128) THEN
		READ (ILU,ERR=99) M
		MP=3
	ENDIF
	M3=M(MP)
	M2=M(MP-1)
	M1=M(MP-2)
	IF (M3.EQ.999) GOTO 99
	RETURN
99	M3=11
	RETURN
	END
C
	INTEGER FUNCTION IPCLIP(X,Y,XM,YM,XX,YX)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	CHECKS TO SEE IF POINT XY IS IN RECTANGLE (XM,YM)-(XX,YX)
C	OR ON THE BOUNDRY -- RETURNS ZERO OR A CODE INDICATING POSITION
C
	INTEGER CD
	CD=0
	IF (X.LT.XM) THEN
		CD=1
	ELSE
		IF (X.GT.XX) CD=2
	ENDIF
	IF (Y.LT.YM) THEN
		CD=CD+4
	ELSE
		IF (Y.GT.YX) CD=CD+8
	ENDIF
	IPCLIP=CD
	RETURN
	END
C
C
	SUBROUTINE SETPAR
C
C	SET PRINTER DEPENDENT PARAMETERS
C
	COMMON /RAST/XSWIDE,YSWIDE,XRES,YRES,XLIM,YLIM,IXOFF,IYOFF,MAXSTR
C
C	XSWIDE	LENGTH OF STRIP IN X DIRECTION (INCH) (XSWIDE<=XLIM)
C	YSWIDE	LENGTH OF STRIP IN X DIRECTION (INCH) (YSWIDE<=YLIM)
C	XRES	OUTPUT DEVICE RESOLUTION IN X DIRECTION (DOT/INCH)
C	YRES	OUTPUT DEVICE RESOLUTION IN Y DIRECTION (DOT/INCH)
C	XLIM	LIMIT OF MOTION IN X DIRECTION (INCH)
C	YLIM	LIMIT OF MOTION IN Y DIRECTION (INCH)
C	IXOFF	X OFFSET (DOTS)
C	IYOFF	Y OFFSET (DOTS)
C	MAXSTR	MAXIMUM NUMBER OF STRIPS BEFORE WARNING
C
	XSWIDE=10.5
	YSWIDE=8.25
	XLIM=10.7
	YLIM=8.5
	XRES=1000.
	YRES=1000.
	IXOFF=0
	IYOFF=0
	MAXSTR=6
C
	RETURN
	END
C
C
	SUBROUTINE LASOUT(M1,M2,M3,ILU)
C
C	WRITE DATA TO QMS LASER PRINTER OUTPUT FILE
C
	CHARACTER*1 HEX(16)
	DATA HEX/'0','1','2','3','4','5','6','7','8','9','A','B',
     $		'C','D','E','F'/
C
	INTEGER MTRANS(16)
	DATA MTRANS/0,2,7,4,6,10,8,1,11,9,3,5,12,13,14,15/
C	
C	EXECUTE COMMAND
C
	GOTO (200,20,20,200,200,60,200,100,100,50) M3
	GOTO 200
C
C	PEN MOTION COMMAND
C
20	CONTINUE			! NORMAL PLOT COMMAND
	CALL SOMEPLOT(M1,M2,M3,ILU)
	GOTO 200
C
C	LINE TYPE
C
60	CONTINUE			! NEW PEN TYPE
C
C	EMPTY OUTPUT BUFFER
C
	CALL SOMEPLOT(M1,M2,0,ILU)
C
C	WRITE LINE TYPE
C
	MM=M1+1
	IF (MM.LT.1) MM=1
	IF (MM.GT.16) MM=16
	MM=MTRANS(MM)+1
	WRITE (ILU,403) HEX(MM)
403	FORMAT(X,'^V',A1)
	GOTO 200
C
C	LINE WIDTH
C
50	CONTINUE			! LINE WIDTH
	MM=M1
	IF (MM.LE.0) MM=1
	IF (MM.NE.4) MM=MM+4		! DEFAULT IS WIDER
C
C	EMPTY OUTPUT BUFFER
C
	CALL SOMEPLOT(M1,M2,0,ILU)
C
C	WRITE LINE WIDTH CHANGE
C
	MMD=(2*MM-7)/10
	IF (MMD.GT.9) MMD=0
	MML=MOD(2*MM-7,10)
	WRITE (ILU,404) MMD,MML
404	FORMAT(X,'^PW',2I1)
	GOTO 200
C
C	END OF PLOT
C
100	CONTINUE
C
C	EMPTY OUTPUT BUFFER
C
	CALL SOMEPLOT(IX,IY,0,ILU)
200	RETURN
	END
C
	SUBROUTINE SOMEPLOT(IX,IY,I,ILU)
C
C	OUTPUT BUFFER FOR PEN COMMANDS TO MINIMIZE LINE LENGTH
C
	CHARACTER*1 LINE(132),U,D,E,C,A
	DATA U/'U'/,E/'E'/,A/'^'/,C/':'/,D/'D'/
	DATA NCNT/0/,LX/-1/,LY/-1/,LP/0/
C
400	FORMAT(X,132A1)
	IF (I.EQ.0) THEN
C
C	EMPTY BUFFER
C
		IF (NCNT.GT.0) WRITE (ILU,400) (LINE(J),J=1,NCNT)
		NCNT=0
		LP=I
		LX=-1
		LY=-1
	ELSE IF (I.EQ.3) THEN
C
C	PEN UP MOVE
C
		IF (LX.EQ.IX.AND.LY.EQ.IY) GOTO 20
		IF (LP.EQ.3.AND.NCNT.GT.0) NCNT=NCNT-13
		IF (NCNT+13.GT.131) THEN
			WRITE (ILU,400) (LINE(J),J=1,NCNT)
			NCNT=0
		ENDIF
		LINE(NCNT+1)=A
		LINE(NCNT+2)=U
		CALL ENCOD(5,LINE(NCNT+3),IY)
		LINE(NCNT+8)=C
		CALL ENCOD(5,LINE(NCNT+9),IX)
		NCNT=NCNT+13
		LP=I
		LX=IX
		LY=IY
	ELSE
C
C	PEN DOWN MOVE
C
		IF (LP.EQ.2.AND.LX.EQ.IX.AND.LY.EQ.IY) GOTO 20
		IF (NCNT+13.GE.131) THEN
			WRITE (ILU,400) (LINE(J),J=1,NCNT)
			NCNT=0
		ENDIF
		LINE(NCNT+1)=A
C
C	PEN ERASE OR PEN DOWN
C
		IF (I.EQ.9) THEN
			LINE(NCNT+2)=E
		ELSE
			LINE(NCNT+2)=D
		ENDIF
C
		CALL ENCOD(5,LINE(NCNT+3),IY)
		LINE(NCNT+8)=C
		CALL ENCOD(5,LINE(NCNT+9),IX)
		NCNT=NCNT+13
		LP=I
		LX=IX
		LY=IY
	ENDIF
20	RETURN
	END
C
C
	SUBROUTINE ENCOD(N,L,I)
C
C	CREATS AN N 'DIGIT' CHARACTER STRING IN L OF THE VALUE OF I
C
	CHARACTER*1 L(N)
	CHARACTER*1 NUMS(10)
	DATA NUMS/'0','1','2','3','4','5','6','7','8','9'/
C
	II=I
	M=10**(N-1)
	IF (II.GE.M*10) THEN
C
C	INPUT TOO LARGE, FILL WITH MAX VALUE
C
		DO 5 J=1,N
			L(J)=NUMS(10)
5		CONTINUE
	ELSE
		DO 10 J=1,N
			JJ=II/M+1
			L(J)=NUMS(JJ)
			II=MOD(II,M)
			M=M/10
10		CONTINUE
	ENDIF
C
	RETURN
	END
